#################################################################
############### Wait, There's Torture in Zootopia? ##############
####################### Plots and Figures #######################
###################### Delehanty & Kearns #######################
######################## December 2019 ##########################
#################################################################

#if you haven't before, install these packages:
install.packages("haven")
install.packages("ggpubr")
install.packages("ggplot2")
install.packages("dplyr")
install.packages("ggrepel")
install.packages("broom")
install.packages("GGally")
install.packages("stringr")

#load packages
library(haven)
library(ggpubr)
library(ggplot2)
library(dplyr)
library(ggrepel)
library(broom)
library(GGally)
library(stringr)
library(scales)

#import data
master <- read_dta("PoP.MainData.dta")
View(master)


##################################################################
########### Plots of Sample Breakdown by MPAA Rating #############
##################################################################
#create a new data frame with # of torture scenes per movie
torturebymovie <- master %>%
  group_by(movieid) %>%
  summarize(total_torture = sum(torture, na.rm=FALSE), 
            rating = mean(mpaa_rating), 
            title = first(title), 
            gross = first(total_gross), 
            year = first(year))

torturebyrating <- torturebymovie %>%
  group_by(rating) %>%
  summarize(total_torture = sum(total_torture, na.rm=FALSE), no_movies = n())

#create new variables for the % of total for # of torture scenes and # of movies
torturebyrating$pct_torture <- (torturebyrating$total_torture / 284)
torturebyrating$pct_movies <- (torturebyrating$no_movies / 200)

#create a value label for ratings
torturebyrating$rating <- factor(torturebyrating$rating, levels = c(1,2,3,4), labels = c("G", "PG", "PG-13", "R"))
torturebymovie$rating <- factor(torturebymovie$rating, levels = c(1,2,3,4), labels = c("G", "PG", "PG-13", "R"))

#create the data set we need
torturebyrating2 <- torturebyrating
torturebyrating$percentage <- torturebyrating$pct_movies
torturebyrating$raw <- torturebyrating$no_movies
torturebyrating$facet <- "Number of Movies in Sample"
torturebyrating2$facet <- "Number of Torture Scenes"
torturebyrating2$percentage <- torturebyrating$pct_torture
torturebyrating2$raw <- torturebyrating$total_torture

#put it all together
torturebyratingfull <- rbind(torturebyrating, torturebyrating2)

################ Sample Plot 1 ########################

sampleplot1 <- ggplot(torturebyratingfull, aes(factor(rating), raw, fill=factor(facet))) + 
  geom_bar(stat="identity", position="dodge") +
  scale_fill_manual(values = c("#56B4E9", "#0072B2"))+
  geom_text(aes(label=raw), size = 4, 
            position=position_dodge(0.9), show.legend = F, vjust= -0.1)+
  xlab("")+
  ylab("")+
  labs(fill="")+
  theme_pubclean()

sampleplot1

######### Sample Plot 2 ############

sampleplot2 <- ggplot(torturebymovie, aes(year, total_torture)) +
  geom_jitter(aes(color=rating), height = 0)+
  scale_x_discrete(name = "Date of Release", limits=c(2008,2009,2010,2011,2012,2013,2014,2015,2016,2017))+
  scale_y_discrete(name="Number of Scenes", limits=c(0,5,10,15))+
  scale_color_manual(values=c("#000000", "#E69F00", "#009E73", "#CC79A7"), name="MPAA Rating")+
  geom_text_repel(aes(label=ifelse(total_torture>7, as.character(title),"")), 
                  nudge_y = -0.3, nudge_x = 0, size=3)+
  ggtitle("Torture Scenes in Major Motion Pictures")+
  theme_pubclean() +
  theme(plot.title=element_text(color="#666666", face="bold", size=18, hjust=0.5))+
  theme(legend.position="right")

sampleplot2

###################################################################################
###### Sample Plot 3: Torture Scenes by Antag/Protag###############################
###################################################################################
torturescenes <- filter(master, torture==1)

protagonistperps_all <- torturescenes %>%
  group_by(perp_protagonist) %>%
  summarize(Scenes = sum(torture, na.rm=FALSE), 
            Punishing = sum(punishment, na.rm=FALSE), 
            Instrumental = sum(instrumental, na.rm=FALSE), 
            Both = sum(punishment[instrumental==1]))

#adjust these numbers for %s
protagonistperps_all$Punishing <- protagonistperps_all$Punishing / protagonistperps_all$Scenes
protagonistperps_all$Instrumental <- protagonistperps_all$Instrumental / protagonistperps_all$Scenes
protagonistperps_all$Both <- protagonistperps_all$Both / protagonistperps_all$Scenes

provant = subset(protagonistperps_all, select = -c(Scenes))
subset(mydata, select = -c(x,z) )

#create the data we need for stupid ggplot to understand what I want to do
library(reshape2)
protags_long <- melt(provant,id.vars="perp_protagonist")

protags_long$perp_protagonist <- factor(protags_long$perp_protagonist, levels = c(0,1), labels = c("Antagonists, n=184","Protagonists, n=100"))

sampleplot3 <- ggplot(protags_long, aes(x=variable,y=value,fill=factor(perp_protagonist)))+
  geom_bar(stat="identity",position="dodge")+
  geom_text(aes( label = scales::percent(value)), position=position_dodge(width=0.9), vjust = -.1) +
  scale_fill_manual(name="",
                    values = c("#56B4E9", "#0072B2"))+
  scale_y_continuous(labels = scales::percent, limits=c(0,1))+
  labs(y="percent")+
  xlab("")+
  ylab("")+
  ggtitle("Torture Scenes by Goal and Perpetrator")+
  theme_pubclean()

sampleplot3

##################################################################
############ Variables for H3-H6 #################################
##################################################################
scenes_detail <- torturescenes %>%
  group_by(perp_protagonist) %>%
  summarize(Scenes = sum(torture, na.rm=FALSE), 
            Threat = sum(threat, na.rm=FALSE), 
            Efficacy = sum(efficacy_rc[efficacy_rc!=-88], na.rm=FALSE), 
            Female_Victim = sum(victim_female),
            Capable = sum(capability_yes))

#adjust these numbers for %s
scenes_detail$Threat <- scenes_detail$Threat / scenes_detail$Scenes
scenes_detail$Efficacy <- scenes_detail$Efficacy / scenes_detail$Scenes
scenes_detail$Female_Victim <- scenes_detail$Female_Victim / scenes_detail$Scenes
scenes_detail$Capable <- scenes_detail$Capable / scenes_detail$Scenes

scenes_detail = subset(scenes_detail, select = -c(Scenes))

#create the data we need for stupid ggplot to understand what I want to do
library(reshape2)
scenes_detail_long <- melt(scenes_detail,id.vars="perp_protagonist")

scenes_detail_long$perp_protagonist <- factor(scenes_detail_long$perp_protagonist, levels = c(0,1), labels = c("Antagonists, n=184","Protagonists, n=100"))

sampleplot4 <- ggplot(scenes_detail_long, aes(x=variable,y=value,fill=factor(perp_protagonist)))+
  geom_bar(stat="identity",position="dodge")+
  geom_text(aes( label = scales::percent(value)), position=position_dodge(width=0.9), vjust = -.1) +
  scale_fill_manual(name="",
                    values = c("#56B4E9", "#0072B2"))+
  scale_y_continuous(labels = scales::percent, limits=c(0,1))+
  labs(y="percent",
       title = "Torture Scene Characteristics by Perpetrator",
       caption = "*Only applies to 'instrumental' torture scenes")+
  xlab("")+
  ylab("")+
  scale_x_discrete(labels= c("Threat","Successful*","Female Victim", "Capable of Complying*"))+
  theme_pubclean()

sampleplot4

##################################################################
##### H1: Instrumental Torture is Effective Most of the Time #####
##################################################################

instrumental <- filter(master, instrumental == 1)
instrumental_g <-filter(instrumental, mpaa_rating==1)
instrumental_pg <- filter(instrumental, mpaa_rating==2)
instrumental_pg13 <- filter(instrumental, mpaa_rating==3)
instrumental_r <- filter(instrumental, mpaa_rating==4)

q <- t.test(instrumental$efficacy_rc, mu=.5)
q <- tidy(q, conf.int=TRUE)
q$term <- "All Movies"

r <- t.test(instrumental_g$efficacy_rc, mu=.5)
r <- tidy(r, conf.int=TRUE)
r$term <- " G"

s <- t.test(instrumental_pg$efficacy_rc, mu=.5)
s <- tidy(s, conf.int=TRUE)
s$term <- " PG"

t <- t.test(instrumental_pg13$efficacy_rc, mu=.5)
t <- tidy(t, conf.int=TRUE)
t$term <- " PG-13"

u <- t.test(instrumental_r$efficacy_rc, mu=.5)
u <- tidy(u, conf.int=TRUE)
u$term <- " R"

all <- rbind(q,r,s,t,u)

h1_plot <- ggcoef(all, vline_intercept = .5, vline_color = "red",
                  errorbar_color = "blue", errorbar_height = .5,
                  vline_linetype = "dotted") +
  labs(title = "H1: Effectiveness of Instrumental Torture", 
       subtitle = "One sample t-test using hypothetical mean of 0.5") + 
  xlab("Estimated Mean with 95% Confidence Intervals") +
  ylab("") +
  geom_label_repel(aes(label=sprintf("%0.2f", round(estimate, digits = 2))), size = 3.5, data=all, show.legend = TRUE) + 
  theme_pubclean() +
  xlim(0,1.3)+
  theme(plot.title=element_text(color="#666666", face="bold", size=20, hjust=0))+
  theme(plot.subtitle=element_text(color="#666666", face="bold", size=10, hjust=0))+
  theme(axis.text.y=element_text(size=13))

h1_plot

#################################################################
### H3: Protags more likely to torture in response to threat ###
#################################################################
torture_protag <- filter(torturescenes, perp_protagonist==1)
torture_antag <- filter(torturescenes, perp_antagonist==1)

e <- t.test(torture_protag$threat, mu=.5)
e <- tidy(e, conf.int=TRUE)
e$term <- "Protagonist"

f <- t.test(torture_antag$threat, mu=.5)
f <- tidy(f, conf.int=TRUE)
f$term <- "Antagonist"

ef <- rbind(e,f)

h3_plot <- ggcoef(ef, vline_intercept = .5, vline_color = "red",
                   errorbar_color = "blue", errorbar_height = .25,
                   vline_linetype = "dotted") +
  labs(title = "H3: Likelihood of torturing in response to a threat", 
       subtitle = "One sample t-test using hypothetical mean of 0.5") + 
  xlab("Estimated Mean with 95% Confidence Intervals") +
  ylab("") +
  geom_label_repel(aes(label=sprintf("%0.2f", round(estimate, digits = 2))), size = 3.5, data=ef, show.legend = TRUE) + 
  theme_pubclean() +
  xlim(0,1) +
  theme(plot.title=element_text(color="#666666", face="bold", size=20, hjust=0))+
  theme(plot.subtitle=element_text(color="#666666", face="bold", size=10, hjust=0))+
  theme(axis.text.y=element_text(size=13))

h3_plot

#################################################################
### H4: Effectiveness of Torture, Protagonists v. Antagonists ###
#################################################################
instrumental_protag <- filter(instrumental, protagonist_perp==1)
instrumental_antag <- filter(instrumental, protagonist_perp==0)

a <- t.test(instrumental_protag$efficacy_rc, mu=.5)
a <- tidy(a, conf.int=TRUE)
a$term <- "Protagonist"

b <- t.test(instrumental_antag$efficacy_rc, mu=.5)
b <- tidy(b, conf.int=TRUE)
b$term <- "Antagonist"

ab <- rbind(a,b)

h4_plot <- ggcoef(ab, vline_intercept = .5, vline_color = "red",
                  errorbar_color = "blue", errorbar_height = .25,
                  vline_linetype = "dotted") +
  labs(title = "Effectiveness of instrumental torture", 
       subtitle = "One sample t-test using hypothetical mean of 0.5") + 
  xlab("Estimated Mean with 95% Confidence Intervals") +
  geom_label_repel(aes(label=sprintf("%0.2f", round(estimate, digits = 2))), size = 3.5, data=ab, show.legend = TRUE) + 
  ylab("") +
  theme_pubclean() +
  xlim(0,1) +
  theme(plot.title=element_text(color="#666666", face="bold", size=20, hjust=0))+
  theme(plot.subtitle=element_text(color="#666666", face="bold", size=10, hjust=0))+
  theme(axis.text.y=element_text(size=13))

h4_plot

#################################################################
# H5: Protagonists Are Less Likely to Torture Women #
#################################################################
torturescenes <- filter(master, torture==1)
torture_protag <- filter(torturescenes, perp_protagonist==1)
torture_antag <- filter(torturescenes, perp_antagonist==1)

cc <- t.test(torture_protag$victim_female, mu=.5)
cc <- tidy(cc, conf.int=TRUE)
cc$term <- "Protagonist"

dd <- t.test(torture_antag$victim_female, mu=.5)
dd <- tidy(dd, conf.int=TRUE)
dd$term <- "Antagonist"

ccdd <- rbind(cc,dd)

h5_plot <- ggcoef(ccdd, vline_intercept = .5, vline_color = "red",
                   errorbar_color = "blue", errorbar_height = .25,
                   vline_linetype = "dotted") +
  labs(title = "Likelihood of torturing women", 
       subtitle = "One sample t-test using hypothetical mean of 0.5") + 
  xlab("Estimated Mean with 95% Confidence Intervals") +
  ylab("") +
  theme_pubclean() +
  xlim(0,1)+
  geom_label_repel(aes(label=sprintf("%0.2f", round(estimate, digits = 2))), size = 3.5, data=ccdd, show.legend = TRUE) + 
  theme(plot.title=element_text(color="#666666", face="bold", size=20, hjust=0))+
  theme(plot.subtitle=element_text(color="#666666", face="bold", size=10, hjust=0))+
  theme(axis.text.y=element_text(size=13))


h5_plot


##################################################################
# H6: Perps more likely to torture someone capable of complying #
##################################################################

h <- t.test(instrumental$capability_yes, mu=.5)
h <- tidy(h, conf.int=TRUE)
h$term <- "All Movies"

#This won't run, since there's no variation. I'll create a data frame by hand so that we can graph this
#g <- t.test(instrumental_g$capability_yes, mu=.5)
#g <- tidy(g, conf.int=TRUE)
#g$term <- " G"
estimate <- 1
statistic <- 13
p.value <- 0
parameter <- 8
conf.low <- 1
conf.high <- 1
method <- "One Sample t-test"
alternative <- "two.sided"
g <- data.frame(estimate, statistic, p.value, parameter, conf.low, conf.high, method, alternative)
g$term <- " G"


i <- t.test(instrumental_pg$capability_yes, mu=.5)
i <- tidy(i, conf.int=TRUE)
i$term <- " PG"

j <- t.test(instrumental_pg13$capability_yes, mu=.5)
j <- tidy(j, conf.int=TRUE)
j$term <- " PG-13"

k <- t.test(instrumental_r$capability_yes, mu=.5)
k <- tidy(k, conf.int=TRUE)
k$term <- " R"


ghijk <- rbind(g,h,i,k,j)

h6_plot <- ggcoef(ghijk, vline_intercept = .5, vline_color = "red",
                   errorbar_color = "blue", errorbar_height = .25,
                   vline_linetype = "dotted") +
  labs(title = "Likelihood of Torturing Those Capable of Complying", 
       subtitle = "One sample t-test using hypothetical mean of 0.5") + 
  xlab("Estimated Mean with 95% Confidence Intervals") +
  geom_label_repel(aes(label=sprintf("%0.2f", round(estimate, digits = 2))), size = 3.5, data=ghijk, show.legend = TRUE) + 
  ylab("") +
  theme_pubclean() +
  xlim(0,1.1)+
  annotate("text", x=0.75, y=1, label = "No Variation Among 8 Scenes in G Movies")+
  theme(axis.text.y=element_text(size=15))+
  theme(plot.title=element_text(color="#666666", face="bold", size=20, hjust=-0.3))+
  theme(plot.subtitle=element_text(color="#666666", face="bold", size=10, hjust=0))

h6_plot

#Thanks for reading our code! Please feel free to contact us with any questions, comments, or
#concerns. Casey Delehanty: cpdelehanty@gmail.com. Erin M. Kearns: emkearns@ua.edu.